home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / KEYBOARD.SWG / 0003_Keyboard routines for TP6.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-02-21  |  3.2 KB  |  85 lines
  1. {
  2.  > I'm glad this was brought up.  I recently made a simple program (in
  3.  > assembly, hope I'm not being off-topic here) that would continually
  4.  > change the status of each LED on the keyboard.  I noticed that the
  5.  > LED's would not actually change unless the program ended or I
  6.  > continually pressed keys down, and I eventually had to call a check
  7.  > for keypress interupt to get it to work properly.  Why exactly was
  8.  > this necessary?
  9.  
  10. I'm sorry, but right now I don't have time to see that. Here goes a
  11. program that does that kind of stuff: }
  12.  
  13. program keyboard;
  14. uses crt;
  15. const bit:array[0..7] of byte=(1,2,4,8,16,32,64,128);
  16. var tec: byte absolute $40:$17;
  17.     tec1:byte absolute $40:$18;
  18.     tec2:byte absolute $40:$96;
  19. begin
  20.      clrscr;
  21.      textcolor(15);
  22.      write('                                  TECLAS ACTIVAS');
  23.      gotoxy(1,3);
  24.      write('                   ScrollLock  NumLock  CapsLock  Insert       ');
  25.      gotoxy(1,7);
  26.      write('                                  TECLAS PREMIDAS');
  27.      gotoxy(1,9);
  28.      write('RightAlt  LeftAlt  RightCtrl  LeftCtrl  RightShift  LeftShift  Ins Caps  Num');
  29.      gotoxy(1,12);
  30.      write('Scroll  SysReq');
  31.      repeat
  32.            if (tec and bit[0])<>0 then textcolor(15) else textcolor(0);
  33.            gotoxy(45,10);
  34.            write('√');
  35.            if (tec and bit[1])<>0 then textcolor(15) else textcolor(0);
  36.            gotoxy(57,10);
  37.            write('√');
  38.            if (tec and bit[4])<>0 then textcolor(15) else textcolor(0);
  39.            gotoxy(25,4);
  40.            write('√');
  41.            if (tec and bit[5])<>0 then textcolor(15) else textcolor(0);
  42.            gotoxy(35,4);
  43.            write('√');
  44.            if (tec and bit[6])<>0 then textcolor(15) else textcolor(0);
  45.            gotoxy(45,4);
  46.            write('√');
  47.            if (tec and bit[7])<>0 then textcolor(15) else textcolor(0);
  48.            gotoxy(54,4);
  49.            write('√');
  50.            if (tec1 and bit[5])<>0 then textcolor(15) else textcolor(0);
  51.            gotoxy(76,10);
  52.            write('√');
  53.            if (tec1 and bit[6])<>0 then textcolor(15) else textcolor(0);
  54.            gotoxy(70,10);
  55.            write('√');
  56.            if (tec1 and bit[7])<>0 then textcolor(15) else textcolor(0);
  57.            gotoxy(65,10);
  58.            write('√');
  59.            if (tec1 and bit[4])<>0 then textcolor(15) else textcolor(0);
  60.            gotoxy(3,13);
  61.            write('√');
  62.            if (tec1 and bit[2])<>0 then textcolor(15) else textcolor(0);
  63.            gotoxy(11,13);
  64.            write('√');
  65.            if (tec2 and bit[3])<>0 then textcolor(15) else textcolor(0);
  66.            gotoxy(4,10);
  67.            write('√');
  68.            if (tec2 and bit[2])<>0 then textcolor(15) else textcolor(0);
  69.            gotoxy(24,10);
  70.            write('√');
  71.            if (tec1 and bit[1])<>0 then textcolor(15) else textcolor(0);
  72.            gotoxy(14,10);
  73.            write('√');
  74.            if (tec1 and bit[0])<>0 then textcolor(15) else textcolor(0);
  75.            gotoxy(35,10);
  76.            write('√');
  77.      until keypressed and (upcase(readkey)='X');
  78. end.
  79.  
  80. It's for Turbo Pascal.
  81.  
  82. You can also get info on this in Ralph's Brown Interrupt List,
  83. available on some BBS.
  84.  
  85.